
#include "../basic/operator.h"
#include "../basic/basic.h"

/* get new cons cell */
Cell* make_pair(Scheme *sc, Cell* a, Cell* b, int immutable) {
	Cell* x = make_cell(sc, a, b);
	if (immutable)
		set_immutable(x);
	return (x);
}

// (car x)
Cell* op_car(Scheme *sc) {
	sc->returnValue = caar(sc->args);
	return pop_callstack(sc);
}

// (cdr x)
Cell* op_cdr(Scheme *sc) {
	sc->returnValue = cdar(sc->args);
	return pop_callstack(sc);
}

// (cons x y) => (x . y) ：x不变，y=car(y)
Cell* op_cons(Scheme *sc) {
	CDR(sc->args) = cadr(sc->args);
	sc->returnValue = sc->args;
	return pop_callstack(sc);
}

// (set-car! x y)
Cell* op_setcar(Scheme *sc) {
	if (!is_immutable(car(sc->args))) {
		CAAR(sc->args) = cadr(sc->args);
		sc->returnValue = car(sc->args);
		return pop_callstack(sc);
	} else {
		return make_default_exception(sc, "UNABLE_TO_ALTER", "set-car!: unable to alter immutable pair.");
	}
}

// (set-cdr! x y)
Cell* op_setcdr(Scheme *sc) {
	if (!is_immutable(car(sc->args))) {
		CDAR(sc->args) = cadr(sc->args);
		sc->returnValue = car(sc->args);
		return pop_callstack(sc);
	} else {
		return make_default_exception(sc, "UNABLE_TO_ALTER", "set-cdr!: unable to alter immutable pair.");
	}
}

void init_pair_operators(Scheme *sc) {
	ADD_OPERATOR(sc, "car", car);
	ADD_OPERATOR(sc, "cdr", cdr);
	ADD_OPERATOR(sc, "cons", cons);
	ADD_OPERATOR(sc, "set-car!", setcar);
	ADD_OPERATOR(sc, "set-cdr!", setcdr);
}
